{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Vote.Internal.Opaleye where

import Data.Aeson.TH (defaultOptions, deriveJSON)
import Data.Profunctor (Profunctor (..))
import Data.Profunctor.Product
import Data.Profunctor.Product.TH (makeAdaptorAndInstanceInferrable')
import Data.String (String)
import Data.Time (UTCTime)
import Opaleye (Select, SqlInt8, SqlText, SqlTimestamptz, Table, TableFields, optionalTableField, requiredTableField, selectTable, table, SqlInt4)
import Opaleye.Field (Field)
import Protolude
import Vote.TH.Opaleye (PropD, PropS, makeTable)

data EntityT a b c d e f = EntityT
  { entityId :: a,
    entityValue :: b,
    entityCreatedBy :: c,
    entityCreatedAt :: d,
    entityUpdatedBy :: e,
    entityUpdatedAt :: f
  }

makeAdaptorAndInstanceInferrable' ''EntityT

deriveJSON defaultOptions ''EntityT

type EntityT' v = EntityT Int64 v Text UTCTime Text UTCTime

type EntityW v = EntityT () v (Field SqlText) () (Field SqlText) ()

type EntityV v = EntityT (Field SqlInt8) v (Field SqlText) (Field SqlTimestamptz) (Field SqlText) (Field SqlTimestamptz)

wrapEntityMapping ::
  TableFields a b ->
  EntityT
    (TableFields () ())
    (TableFields a b)
    (TableFields () ())
    (TableFields () ())
    (TableFields () ())
    (TableFields () ())
wrapEntityMapping mapping =
  EntityT
    { entityId = pure (),
      entityValue = mapping,
      entityCreatedBy = pure (),
      entityCreatedAt = pure (),
      entityUpdatedBy = pure (),
      entityUpdatedAt = pure ()
    }

withId ::
  EntityT (TableFields () ()) b c d e f ->
  EntityT (TableFields () (Field SqlInt8)) b c d e f
withId mapping =
  mapping
    { entityId = lmap (\() -> Nothing) (optionalTableField "id")
    }

withTimestamps ::
  EntityT a b c (TableFields () ()) e (TableFields () ()) ->
  EntityT a b c (TableFields () (Field SqlTimestamptz)) e (TableFields () (Field SqlTimestamptz))
withTimestamps mapping =
  mapping
    { entityCreatedAt = lmap (\() -> Nothing) (optionalTableField "created_at"),
      entityUpdatedAt = lmap (\() -> Nothing) (optionalTableField "updated_at")
    }

withOperators ::
  EntityT a b (TableFields () ()) d (TableFields () ()) f ->
  EntityT a b (TableFields (Field SqlText) (Field SqlText)) d (TableFields (Field SqlText) (Field SqlText)) f
withOperators mapping =
  mapping
    { entityCreatedBy = requiredTableField "created_by",
      entityUpdatedBy = requiredTableField "updated_by"
    }

entityTable :: String -> TableFields a a -> Table (EntityW a) (EntityV a)
entityTable tableName v =
  table tableName . pEntityT $
    wrapEntityMapping
      v
      & withId
      & withOperators
      & withTimestamps

--

data SceneT a b c d e = Scene
  { sceneInfo :: a,
    sceneType :: b,
    sceneTimeOpen :: c,
    sceneTimeShut :: d,
    sceneMarkDeno :: e
  }

makeAdaptorAndInstanceInferrable' ''SceneT

deriveJSON defaultOptions ''SceneT

type Scene = EntityT' (SceneT Text Text UTCTime UTCTime Int64)

type SceneW = EntityW (SceneT (Field SqlText) (Field SqlText) (Field SqlTimestamptz) (Field SqlTimestamptz) (Field SqlInt8))

type SceneV = EntityV (SceneT (Field SqlText) (Field SqlText) (Field SqlTimestamptz) (Field SqlTimestamptz) (Field SqlInt8))

sceneTable :: Table SceneW SceneV
sceneTable =
  entityTable "scene" $
    pScene
      Scene
        { sceneInfo = requiredTableField "info",
          sceneType = requiredTableField "type",
          sceneTimeOpen = requiredTableField "time_open",
          sceneTimeShut = requiredTableField "time_shut",
          sceneMarkDeno = requiredTableField "mark_deno"
        }

sceneSelect :: Select SceneV
sceneSelect = selectTable sceneTable

--

newtype ActorT a = Actor
  { actorInfo :: a
  }

makeAdaptorAndInstanceInferrable' ''ActorT

type Actor = EntityT' (ActorT Text)

type ActorW = EntityW (ActorT (Field SqlText))

type ActorV = EntityV (ActorT (Field SqlText))

actorTable :: Table ActorW ActorV
actorTable =
  entityTable "actor" $
    pActor
      Actor
        { actorInfo = requiredTableField "info"
        }

--

data VoterT a b c = Voter
  { voterInfo :: a,
    voterFactorNume :: b,
    voterFactorDeno :: c
  }

makeAdaptorAndInstanceInferrable' ''VoterT

type Voter = EntityT' (VoterT Text Int64 Int64)

type VoterW = EntityW (VoterT (Field SqlText) (Field SqlInt8) (Field SqlInt8))

type VoterV = EntityV (VoterT (Field SqlText) (Field SqlInt8) (Field SqlInt8))

voterTable :: Table VoterW VoterV
voterTable =
  entityTable "voter" $
    pVoter
      Voter
        { voterInfo = requiredTableField "info",
          voterFactorNume = requiredTableField "factor_nume",
          voterFactorDeno = requiredTableField "factor_deno"
        }

--

data ActionT a b c d = Action
  { actionSceneId :: a,
    actionActorId :: b,
    actionVoterId :: c,
    actionMark :: d
  }

makeAdaptorAndInstanceInferrable' ''ActionT

type Action = EntityT' (ActionT Int64 Int64 Int64 Int64)

type ActionW = EntityW (ActionT (Field SqlInt8) (Field SqlInt8) (Field SqlInt8) (Field SqlInt8))

type ActionV = EntityV (ActionT (Field SqlInt8) (Field SqlInt8) (Field SqlInt8) (Field SqlInt8))

tblAction :: Table ActionW ActionV
tblAction =
  entityTable "action" $
    pAction
      Action
        { actionSceneId = requiredTableField "scene_id",
          actionActorId = requiredTableField "actor_id",
          actionVoterId = requiredTableField "voter_id",
          actionMark = requiredTableField "mark"
        }